home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-mpe.el.z / efs-mpe.el
Encoding:
Text File  |  1998-05-21  |  26.5 KB  |  679 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-mpe.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.8 $
  7. ;; RCS:          
  8. ;; Description:  MPE (HP3000) support for efs.
  9. ;; Author:       (Corny de Souza) cdesouza@hpbbn.bbn.hp.com
  10. ;; Created:      Fri Jan 15 12:58:29 1993
  11. ;; Modified:     Sun Nov 27 18:36:13 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. ;;; Credits 
  20. ;;
  21. ;; Sandy Rutherford for his help and advice.
  22.  
  23. ;;; Usage
  24. ;;
  25. ;; For a general description of remote file access see efs.el.
  26. ;;
  27. ;; MPE Specifics
  28. ;;
  29. ;; *) To make things easier (for me) MPE has been UNIXified so think UNIX 
  30. ;;    and you stand a good chance of understanding everything.
  31. ;;
  32. ;; *) Filename syntax is as follows
  33. ;;
  34. ;;    /session,user.account,group@system:/account/group/file;buildparms
  35. ;;    
  36. ;;    the "session," and ",group" in the logon sequence are optional.
  37. ;;
  38. ;;    e.g. /CDSUSER.OSCAR@SYSTEM41:/OSCAR/CDSSRC/TST0000S
  39. ;;    will get the file TST0000S.CDSSRC.OSCAR
  40. ;;
  41. ;;    The ";buildparms" is also optional. It should be used when creating
  42. ;;    files whos characteristics differ from the default system buildparms,
  43. ;;    described in the file FTPDOC.ARPA.SYS (at least it is on my system).
  44. ;;    Also see variable efs-mpe-default-buildparms.
  45. ;;
  46. ;;    e.g. REC=-256,,V,ASCII
  47. ;;
  48. ;; *) Password syntax is as follows
  49. ;;    
  50. ;;    userpass,accountpass,grouppass
  51. ;;
  52. ;;    Leading commas cannot be omitted, trailing commas can.
  53. ;;    e.g. USERPASS,ACCTPASS   (no group password)
  54. ;;         ,ACCTPASS           (only account password)
  55. ;;         USERPASS,,GRPPASS   (no account password)
  56. ;;
  57. ;; *) Do not use account name completion on large systems. See the variable
  58. ;;    efs-mpe-account-completion-confirm 
  59. ;;
  60. ;; *) Do not use group name completion on large accounts. See the variable
  61. ;;    efs-mpe-group-completion-confirm
  62. ;;
  63. ;; *) The buffers FILE and FILE;BUILDPARMS both point to the same physical
  64. ;;    disc file.
  65. ;;  
  66. ;; *) When using filename completion you will usually be given the option
  67. ;;    between FILE and FILE;BUILDPARMS. Just ignore the FILE;BUILDPARMS
  68. ;;    bit.
  69. ;;
  70. ;; *) WARNING ********* Two buffer for the same file ************ WARNING
  71. ;;    If you land up with two buffers FILE and FILE;BUILDPARMS for the same
  72. ;;    file kill the FILE;BUILDPARMS one. If however this is newwer than
  73. ;;    the FILE buffer (and you cannot live with a buffer called 
  74. ;;    FILE;BUILDPARMS) save it kill both buffers and get the FILE buffer again.
  75. ;;
  76. ;; *) When creating new files only create FILES. It is possible to create
  77. ;;    files as GROUPs and ACCOUNTs but don't!  
  78. ;;
  79. ;;; To Do
  80. ;;
  81. ;; A lot of things are likely to change with MPE 4.5 and POSIX so I do not want
  82. ;; to invest too much time in this now. I would rather wait until I can see
  83. ;; what comes with POSIX.
  84. ;;
  85. ;; Feel free to send bugs, suggestions for enhancements and enhancements
  86. ;; to me cdesouza@hpbbn.bbn.hp.com. If I have TIME I will try to deal with
  87. ;; them. Also I'm not a lisp programmer so keep it simple or put in plenty
  88. ;; of comments.
  89. ;;
  90. ;;
  91. ;; *) Improve on the dired GROUP and ACCOUNT listings.
  92. ;;
  93. ;; *) Add ".." to dired FILE and GROUP listings.
  94. ;;
  95. ;; *) Support POSIX (need POSIX machine first though).
  96. ;;
  97. ;; *) Test ACCOUNT name completion and listings properly. I have the problem
  98. ;;    that the only systems available to me are large ( i.e. start a listf
  99. ;;    @.@.@,2  today and come back tomorrow), which makes
  100. ;;    it pretty hard for me to test.
  101. ;;
  102.  
  103. ;;; Code
  104.  
  105. (provide 'efs-mpe)
  106. (require 'efs)
  107.  
  108. ;;; User Variables
  109.  
  110. (defvar efs-mpe-account-completion-confirm t
  111.   "*Set to non-nil will cause a prompt to be issued before attempting ACCOUNT
  112. name completion. For ACCOUNT name completion a LISTF @.@.@,2 is required. 
  113. This can take a very long time on large systems")
  114.  
  115. (defvar efs-mpe-group-completion-confirm t
  116.   "*Set to non-nil will cause a prompt to be issued before attempting GROUP
  117. name completion. For GROUP name completion a LISTF @.@.ACCOUNT,2 is required. 
  118. This can take a very long time on large accounts")
  119.  
  120. (defvar efs-mpe-default-buildparms ""
  121.   "*If set to non empty string used to override the system default buildparms.")
  122.  
  123. ;;; Internal Variables
  124.  
  125. (defconst efs-mpe-version
  126.   (concat (substring "$efs release: 1.15 $" 14 -2)
  127.       "/"
  128.       (substring "#Revision: 1.8 $" 11 -2)))
  129.  
  130. ;;; Support for build parameters
  131.  
  132. (defun efs-mpe-get-buildparms (path)
  133.   ;; Gets the mpe buildparms for PATH. PATH should be in efs syntax.
  134.   (let ((files (efs-get-files-hashtable-entry (file-name-directory
  135.                            (directory-file-name path)))))
  136.     (if files
  137.     (let* ((file (efs-get-file-part path))
  138.            (completion-ignore-case
  139.         (memq 'mpe efs-case-insensitive-host-types))
  140.            (bpversions (all-completions (concat file ";") files)))
  141.       (cond
  142.        ((null bpversions)
  143.         efs-mpe-default-buildparms)
  144.        ((= (length bpversions) 1)
  145.         (substring (car bpversions) (length file)))
  146.        (t
  147.         (error
  148.          "efs-mpe: %s seems to have more than one set of buildparams."
  149.          path))))
  150.       ;; return the default
  151.       efs-mpe-default-buildparms)))
  152.     
  153. (defun efs-mpe-fix-buildparms (buildparms host user path)
  154.   "Try to assign buildparms for the file being PUT"
  155.   (or
  156.    ;; Buildparms specified with file use them.
  157.    buildparms
  158.    (efs-mpe-get-buildparms (format efs-path-format-string user host path))))
  159.  
  160. ;;; entry points
  161.  
  162. (efs-defun efs-fix-path mpe (path &optional reverse)
  163.   ;; Convert PATH from UNIX-ish to MPE. If REVERSE given then convert from
  164.   ;; MPE to UNIX-ish. N.B. Path does not contain HOST or USER part so the
  165.   ;; dynamic variables HOST and USER are used.
  166.   ;; Also uses the dynamic variable CMD0.
  167.   (efs-save-match-data
  168.     (if reverse
  169.     ;; This is never used as we only convert PWD (see below) output in
  170.     ;; this direction. However I will leave this here should it be
  171.     ;; required in the future.
  172.     (if (let ((case-fold-search t))
  173.           (string-match 
  174.            (concat "^\\([A-Z][A-Z0-9]*\\)"    ; file
  175.                "\\(.[A-Z][A-Z0-9]*\\)"    ; group 
  176.                "\\(.[A-Z][A-Z0-9]*\\)$")  ; account
  177.            path))
  178.         (let (file group account)
  179.           (setq file (substring path 0 (match-end 1))) 
  180.           (if (match-beginning 2) 
  181.           (setq group (substring 
  182.                    path (1+ (match-beginning 2)) (match-end 2))))
  183.           (if (match-beginning 3)
  184.           (setq account (substring 
  185.                  path (1+ (match-beginning 3))
  186.                  (match-end 3))))
  187.           (concat (and account (concat "/" account "/"))
  188.               (and group (concat group "/"))
  189.               file))
  190.       ;; handle PWD output
  191.       (if (let ((case-fold-search t))
  192.         (string-match
  193.          (concat
  194.           "\\([A-Z][A-Z0-9]*\\)?"                  ; sessionname
  195.           ",[A-Z][A-Z0-9]*\.\\([A-Z][A-Z0-9]*\\)," ; username.account
  196.           "\\([A-Z][A-Z0-9]*\\)$")                 ; group
  197.          path))
  198.           (concat "/" 
  199.               (substring path (match-beginning 2) (match-end 2))
  200.               "/"
  201.               (substring path (match-beginning 3) (match-end 3))
  202.               "/")
  203.         (error "Invalid MPE (MPE->UNIX) filename: %s" path)))
  204.       (if (let ((case-fold-search t))
  205.         (string-match 
  206.          (concat 
  207.           "^\\(/[A-Z][A-Z0-9]*/\\)"     ; account
  208.           "\\([A-Z][A-Z0-9]*/\\)"       ; group
  209.           "\\([A-Z][A-Z0-9]*\\)"        ; file 
  210.           "\\(;.*\\)?$")                ; buildparms
  211.          path))
  212.       (let ((for-put (and (boundp 'cmd0) (eq cmd0 'put)))
  213.         file group account buildparms) 
  214.         (setq account (substring 
  215.                path (1+ (match-beginning 1)) (1- (match-end 1))))
  216.         (setq group (substring 
  217.              path (match-beginning 2) (1- (match-end 2))))
  218.         (setq file (substring path (match-beginning 3) (match-end 3))) 
  219.         (if for-put
  220.         (setq buildparms 
  221.               (efs-mpe-fix-buildparms
  222.                (and (match-beginning 4)
  223.                 (substring path
  224.                        (match-beginning 4) (match-end 4)))
  225.                host user path)))
  226.         (concat file
  227.             (and group (concat "." group ))
  228.             (and account (concat "." account ))
  229.             (and for-put buildparms)))
  230.     (error "Invalid MPE (UNIX->MPE) filename: *%s*" path)))))
  231.  
  232. (efs-defun efs-fix-dir-path mpe (dir-path)
  233.   ;; Convert path from UNIX-ish to MPE ready for a DIRectory listing. MPE does
  234.   ;; not have directories as such. It does have GROUPS and ACCOUNTS, but the 
  235.   ;; DIR command does not let you list just ACCOUNTs on the system or just 
  236.   ;; GROUPs in the ACCOUNT - no you always get everything downwards
  237.   ;; i.e. ACCOUNTs + GROUPs + FILEs or GROUPs + FILEs or just FILEs
  238.   ;; depending on the level.
  239.   (efs-save-match-data
  240.     (message "Fixing listing %s ..." dir-path)
  241.     (cond
  242.      ;; Everything !?! might take a while.
  243.      ((string-equal dir-path "/")
  244.       (if efs-mpe-account-completion-confirm
  245.           (if (y-or-n-p "Continue with ACCOUNT name completion? ")
  246.               "@.@.@"
  247.             (error "Quit ACCOUNT name completion"))
  248.           "@.@.@"))
  249.      ;; specification starts with account
  250.      ((let ((case-fold-search t))
  251.     (string-match 
  252.      (concat 
  253.       "^\\(/[A-Z][A-Z0-9]*/\\)"     ; account
  254.       "\\([A-Z][A-Z0-9]*/\\)?"      ; group
  255.       "\\([A-Z][A-Z0-9]*\\)?"       ; file 
  256.       "\\(;.*\\)?/?$")              ; buildparms
  257.      dir-path))
  258.       (let (file group account)
  259.         (setq account (substring dir-path 
  260.                                  (1+ (match-beginning 1)) (1- (match-end 1))))
  261.         (if (match-beginning 2)
  262.             (setq group (substring dir-path
  263.                                    (match-beginning 2) (1- (match-end 2))))
  264.           (if efs-mpe-group-completion-confirm
  265.               (if (y-or-n-p "Continue with GROUP name completion? ")
  266.                   (setq group "@")
  267.                 (error "Quit GROUP name completion"))
  268.             (setq group "@")))
  269.         (if (match-beginning 3)
  270.             ;;(setq file (substring dir-path
  271.             ;;                      (match-beginning 3) (1- (match-end 3))))
  272.             ;; set the filename to something silly so that the DIR will fail
  273.             ;; and so force a DIR for the group instead. Either I've
  274.             ;; misunderstood something or you have to do it like this.  
  275.             (setq file "~!#&*")
  276.           (setq file "@"))
  277.         (concat file "." group "." account)))
  278.      (t
  279.       (error "Invalid MPE (LISTF) filename: %s" dir-path)))))
  280.  
  281. (defconst efs-mpe-acct-grp-line-regexp
  282.   "ACCOUNT= +\\([A-Z][A-Z0-9]*\\) +GROUP= +\\([A-Z][A-Z0-9]*\\)")
  283. (defconst efs-mpe-file-line-regexp
  284.   (concat
  285.    "\\*?  +\\([A-Z0-9]*\\) +\\([0-9]+\\)"
  286.    "\\([BW]\\) +\\([FV]\\)\\([AB]\\)\\([MCO]?\\) +\\([0-9]+\\)"))
  287.  
  288. (efs-defun efs-parse-listing mpe
  289.   (host user dir path &optional switches)
  290.   ;; Parse the current buffer which is assumed to be in
  291.   ;; mpe ftp dir format.
  292.   ;; HOST is the name of the remote host.
  293.   ;; USER is the user name.
  294.   ;; DIR is the directory as a full remote path
  295.   ;; PATH is the directory in full efs-syntax
  296.   ;; SWITCHES are the switches passed to ls (not relevant for mpe)
  297.   (goto-char (point-min))
  298.   (efs-save-match-data
  299.     ;;Make sure this is a valid listing 
  300.     (if (re-search-forward "ACCOUNT= +[A-Z]+ +GROUP=" nil t)
  301.         (let (acct-tbl grp-tbl file-tbl
  302.               account group file
  303.               acct-cur grp-cur)
  304.           (goto-char (point-min))
  305.           ;; Look for something that could be a filename.
  306.           (while (re-search-forward "^[A-Z][A-Z0-9]*" nil t)
  307.             (goto-char (match-beginning 0))
  308.             ;; Check to see if looking at an ACCOUNT= GROUP= line. Could
  309.             ;; be a continuation (cont). line or a change in account or group
  310.             (if (looking-at efs-mpe-acct-grp-line-regexp)
  311.                 (progn 
  312.                   (setq account (buffer-substring (match-beginning 1)
  313.                                                   (match-end 1)))
  314.                   (setq group (buffer-substring (match-beginning 2)
  315.                                                 (match-end 2)))
  316.                   ;;Check for change of account
  317.                   (if (not (string-equal acct-cur account))
  318.                       (progn
  319.                         ;;Create table for account names and fill with 
  320.                         ;; "." entry.
  321.                         (if (not acct-tbl)
  322.                             (progn
  323.                               (setq acct-tbl (efs-make-hashtable))
  324.                               (efs-put-hash-entry "." '(t) acct-tbl)))
  325.                         (efs-put-hash-entry account '(t) acct-tbl)
  326.                         ;;Store the current group table
  327.                         (if grp-tbl
  328.                             (progn 
  329.                               (efs-set-files
  330.                    (efs-replace-path-component
  331.                 path
  332.                 (concat  "/" acct-cur "/"))
  333.                                grp-tbl )
  334.                               (setq grp-tbl nil)))))
  335.                   ;;Check for change in group. Change in account is automatic
  336.                   ;;change in group.
  337.                   (if (or (not (string-equal acct-cur account))
  338.                           (not (string-equal grp-cur group)))
  339.                       (progn 
  340.                         ;;Create table for group names and fill with 
  341.                         ;; "." and ".." entries.
  342.                         (if (not grp-tbl)
  343.                             (progn
  344.                               (setq grp-tbl (efs-make-hashtable))
  345.                               (efs-put-hash-entry "." '(t) grp-tbl)
  346.                               (efs-put-hash-entry ".." '(t) grp-tbl))) 
  347.                         (efs-put-hash-entry group '(t) grp-tbl)
  348.                         ;;Store current file table
  349.                         (if file-tbl
  350.                             (progn 
  351.                               (efs-set-files
  352.                    (efs-replace-path-component
  353.                 path
  354.                 (concat "/" acct-cur "/" grp-cur "/"))
  355.                                file-tbl)
  356.                               (setq file-tbl nil)))))
  357.                   ;;Set new grp-cur and acct-cur incase one or both chnaged.
  358.                   (setq grp-cur group acct-cur account)
  359.                   )
  360.               ;;Looking at either a file name, or the line 
  361.               ;;"FILENAME      CODE --....--LOGICAL.."
  362.               ;;Save the possible filename.
  363.               (setq file (buffer-substring (point) 
  364.                                            (progn 
  365.                                              (skip-chars-forward "A-Z0-9")
  366.                                              (point))))
  367.               ;;Make sure its a file name.
  368.               ;;"\\*?" is for files in access.
  369.               ;; File codes can be numeric as well! CdS
  370.               (if (looking-at efs-mpe-file-line-regexp)
  371.                   ;;Hack out the buildparms
  372.                   (let* ((code (and 
  373.                                (/= (match-beginning 1) (match-end 1))
  374.                                (concat ";CODE=" 
  375.                                        (buffer-substring 
  376.                                         (match-beginning 1) (match-end 1)))))
  377.                         (length (buffer-substring (match-beginning 2)
  378.                                                   (match-end 2)))
  379.                         (eof (buffer-substring (match-beginning 7)
  380.                                                   (match-end 7)))
  381.                         (bytes (* (string-to-int eof)
  382.                                   (string-to-int length)))
  383.                         (word-byte  (buffer-substring (match-beginning 3)
  384.                               (match-end 3)))
  385.                         (fix-var  (buffer-substring (match-beginning 4)
  386.                             (match-end 4)))
  387.                         (ascii-binary  (buffer-substring (match-beginning 5)
  388.                                                   (match-end 5)))
  389.                         (cir-msg (and (match-beginning 6)
  390.                                       (buffer-substring (match-beginning 6)
  391.                                                         (match-end 6))))
  392.                         (rec ";REC="))
  393.                     (if (string-equal word-byte "B")
  394.                         (setq rec (concat rec "-"))
  395.                       (setq bytes (* 2 bytes)))
  396.                     (setq rec (concat rec length ",," fix-var ","))
  397.                     (if (string-equal ascii-binary "A")
  398.                         (setq rec (concat rec "ASCII"))
  399.                       (setq rec (concat rec "BINARY")))
  400.                     (cond ((string-equal cir-msg "M")
  401.                            (setq cir-msg ";MSG"))
  402.                           ((string-equal cir-msg "O")
  403.                            (setq cir-msg ";CIR"))
  404.                           (t
  405.                            (setq cir-msg nil)))
  406.                     (if (not file-tbl)
  407.                         (progn 
  408.                           (setq file-tbl (efs-make-hashtable))
  409.                           (efs-put-hash-entry "." '(t) file-tbl)
  410.                           (efs-put-hash-entry ".." '(t) file-tbl)))
  411.                     (message "Adding... %s" file)
  412.                     (efs-put-hash-entry file (list nil bytes) file-tbl)
  413.                     (efs-put-hash-entry (concat file rec code cir-msg) 
  414.                                              (list nil bytes) file-tbl)))
  415.               ) ;if looking-at
  416.             (forward-line 1)
  417.             );while
  418.           ;;Check at what level the listing was done and return the
  419.           ;;corresponding table. System = acct-tbl, Account = grp-tbl,
  420.           ;;Group = file-tbl.
  421.           (if (let ((case-fold-search t))
  422.         (string-match 
  423.          "\\(/\\)\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?" 
  424.          dir))
  425.               ;;group level listing, just return table of files
  426.               (if (or (match-beginning 3) (match-beginning 4))
  427.                   file-tbl
  428.                 ;;account level listing, return table of groups but do not
  429.                 ;;forget to store current table of files. 
  430.                 (if (match-beginning 2)
  431.                     (progn
  432.                       (if file-tbl
  433.                           (efs-set-files
  434.                (efs-replace-path-component
  435.                 path
  436.                 (concat "/" acct-cur "/" grp-cur "/"))
  437.                            file-tbl))
  438.                       grp-tbl)
  439.                   ;;System level listing, return table of accounts but do not
  440.                   ;;forget to store current table of groups and files
  441.                   (if (match-beginning 1)
  442.                       (progn
  443.                         (if file-tbl
  444.                           (efs-set-files
  445.                (efs-replace-path-component
  446.                 path
  447.                 (concat "/" acct-cur "/" grp-cur "/"))
  448.                file-tbl))
  449.             (if grp-tbl
  450.                 (efs-set-files
  451.                  (efs-replace-path-component
  452.                   path
  453.                   (concat "/" acct-cur "/"))
  454.                  grp-tbl))
  455.                         acct-tbl)
  456.                     (error "Parse listing 0 path %s" path))))
  457.             (error "Parse listing 1 path %s" path))))))
  458.  
  459.  
  460. (efs-defun efs-really-file-p mpe (file ent)
  461.   ;; Doesn't treat the buildparm entry as a real file entry.
  462.   (efs-save-match-data
  463.     (not (string-match ";" file))))
  464.   
  465. (efs-defun efs-delete-file-entry mpe (path &optional dir-p)
  466.   ;; Deletes FILE and FILE;BUILDPARMS from file hashtable.
  467.   (let ((ignore-case (memq 'mpe efs-case-insensitive-host-types)))
  468.     (if dir-p
  469.     (let ((path (file-name-as-directory path))
  470.           files)
  471.       (efs-del-hash-entry path efs-files-hashtable ignore-case)
  472.       (setq path (directory-file-name path)
  473.         files (efs-get-files-hashtable-entry
  474.                (file-name-directory path)))
  475.       (if files
  476.           (efs-del-hash-entry (efs-get-file-part path)
  477.                   files ignore-case)))
  478.       (let ((file (efs-get-file-part path))
  479.         (files (efs-get-files-hashtable-entry
  480.             (file-name-directory path))))
  481.     (if files
  482.         (efs-save-match-data
  483.           (if (string-match ";" file)
  484.           (let ((root (substring file (match-beginning 0))))
  485.             ;; delete ROOT from hashtable
  486.             (efs-del-hash-entry root files ignore-case)
  487.             ;; delete ROOT;BUILDPARAMS from hashtable
  488.             (efs-del-hash-entry file files ignore-case))
  489.         ;; we've specified only a root.
  490.         (let* ((root (concat file ";"))
  491.                (completion-ignore-case ignore-case)
  492.                (extensions (all-completions root files)))
  493.           ;; Get rid of FILE.
  494.           (efs-del-hash-entry file files ignore-case)
  495.           ;; Get rid of all BUILDPARAMS versions
  496.           (while extensions
  497.             ;; all-completions will return names with the right case.
  498.             ;; Don't need to ignore-case now.
  499.             (efs-del-hash-entry (car extensions) files)
  500.             (setq extensions (cdr extensions)))))))))
  501.     (efs-del-from-ls-cache path t ignore-case)))
  502.  
  503. (efs-defun efs-add-file-entry mpe (path dir-p size owner
  504.                     &optional modes nlinks mdtm)
  505.   ;; Deletes FILE (if present) and FILE;BUILDPARMS (if present) from hashtable
  506.   ;; then adds FILE and  FILE;BUILDPARMS (if specified) to hashtable.
  507.   (let ((ignore-case (memq 'mpe efs-case-insensitive-host-types))
  508.     (ent (let ((dir-p (null (null dir-p))))
  509.            (if mdtm
  510.            (list dir-p size owner nil nil mdtm)
  511.          (list dir-p size owner)))))
  512.  
  513.     (if dir-p
  514.     (let* ((path (directory-file-name path))
  515.            (files (efs-get-files-hashtable-entry
  516.                (file-name-directory path))))
  517.       (if files
  518.           (efs-put-hash-entry (efs-get-file-part path) ent files
  519.                   ignore-case)))
  520.       
  521.       (let ((files (efs-get-files-hashtable-entry
  522.             (file-name-directory path))))
  523.     (efs-save-match-data
  524.       (if files
  525.           (let* ((file (efs-get-file-part path))
  526.              (root (substring file 0 (string-match ";" file))))
  527.                 (if (equal root file)
  528.                     (setq file (concat file (efs-mpe-get-buildparms path))))
  529.         ;; In case there is another entry with different buildparams,
  530.         ;; wipe it.
  531.         (efs-delete-file-entry 'mpe path nil)
  532.         (efs-put-hash-entry root ent files ignore-case)
  533.         (efs-put-hash-entry file ent files ignore-case))))))
  534.     (efs-del-from-ls-cache path t ignore-case)))
  535.  
  536. (efs-defun efs-allow-child-lookup mpe (host user dir file)
  537.   ;; Returns non-NIL if FILE in directory DIR could possibly be a subdir
  538.   ;; according to its file-name syntax, and therefore a child listing should
  539.   ;; be attempted. Note that DIR is in directory syntax i.e. /foo/bar/, not
  540.   ;; /foo/bar.
  541.  
  542.   ;; Subdirs in MPE are accounts or groups.
  543.   (string-match "^/\\([^/]+/\\)?$" dir))
  544.             
  545. (efs-defun efs-file-type mpe (path)
  546.   ;; Returns whether to treat an efs file as a text file or not.
  547.   (let ((buildparams (efs-mpe-get-buildparms path)))
  548.     (efs-save-match-data
  549.       (let ((case-fold-search t))
  550.     (cond
  551.      ((string-match "BINARY" buildparams)
  552.       '8-binary)
  553.      (t
  554.       'text))))))
  555.  
  556. ;;; Tree dired support:
  557.  
  558. (efs-defun efs-dired-manual-move-to-filename mpe
  559.   (&optional raise-error bol eol)
  560.   ;; In dired, move to first char of filename on this line.
  561.   ;; Returns position (point) or nil if no filename on this line.
  562.   ;; This is the MPE version.
  563.   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  564.   (let (case-fold-search)
  565.     (if bol
  566.     (goto-char bol)
  567.       (skip-chars-backward "^\n\r"))
  568.     ;; The "\\|ACCOUNT=\\|GROUP=" bit is to take care of the hacked account and
  569.     ;; group dired listings.
  570.     (if (looking-at
  571.      ". [A-Z][A-Z0-9]*\\*?  +\\([A-Z]* +[0-9]+\\|ACCOUNT=\\|GROUP=\\)")
  572.     (progn
  573.       (forward-char 2)
  574.       (point))
  575.       (and raise-error (error "No file on this line")))))
  576.  
  577. (efs-defun efs-dired-manual-move-to-end-of-filename mpe
  578.   (&optional no-error bol eol)
  579.   ;; Assumes point is at beginning of filename.
  580.   ;; So, it should be called only after (dired-move-to-filename t).
  581.   ;; On failure, signals an error or returns nil.
  582.   ;; This is the MPE version.
  583.   (let ((opoint (point)))
  584.     (and selective-display
  585.      (null no-error)
  586.      (eq (char-after
  587.           (1- (or bol (save-excursion
  588.                 (skip-chars-backward "^\r\n")
  589.                 (point)))))
  590.          ?\r)
  591.      ;; File is hidden or omitted.
  592.      (cond
  593.       ((dired-subdir-hidden-p (dired-current-directory))
  594.        (error
  595.         (substitute-command-keys
  596.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  597.       ((error
  598.         (substitute-command-keys
  599.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  600.          )))))
  601.     (skip-chars-forward "A-Z0-9")
  602.     (if (or (= opoint (point)) (not (memq (following-char) '(?\  ?*))))
  603.     (if no-error
  604.         nil
  605.       (error "No file on this line"))
  606.       (point))))
  607.  
  608. (efs-defun efs-dired-ls-trim mpe ()
  609.   ;; trim single file listings 1-line.
  610.   ;; This uses an evil dynamical binding of file.
  611.   (if (and (boundp 'file) (stringp file))
  612.       (let ((f (file-name-nondirectory file)))
  613.     (or (zerop (length f))
  614.         (progn
  615.           (goto-char (point-min))
  616.           (if (search-forward (concat "\n" (upcase file) " ") nil t)
  617.           (progn
  618.             (beginning-of-line)
  619.             (delete-region (point-min) (point))
  620.             (forward-line 1)
  621.             (delete-region (point) (point-max)))))))))
  622.  
  623. (efs-defun efs-dired-fixup-listing mpe (file path &optional switches wildcard)
  624.   ;; File (group) listings stay pretty much as they are group (account) and
  625.   ;; account (system) listings get realy hacked.
  626.   (efs-save-match-data
  627.     (goto-char (point-max))
  628.     (string-match 
  629.      "\\(/\\)\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?" 
  630.      path)
  631.     ;; group or file level listing.
  632.     (if (or (match-beginning 3) (match-beginning 4))
  633.         ;; Hack out the continuation lines.
  634.         (while 
  635.             (re-search-backward
  636.              "\n\nACCOUNT=.+GROUP=.+(CONT\\.)\n\n.*\n.*\n" nil t)
  637.           (replace-match "" nil nil))
  638.         ;;account level listing, hack out everything apart from group names
  639.       (if (match-beginning 2)
  640.           (let ((group nil)
  641.                 (grp-cur nil))
  642.             (while 
  643.                 (re-search-backward
  644.                  "GROUP= +\\([A-Z][A-Z0-9]*\\)\\(.\\|\n\\)*"
  645.                  nil t)
  646.               (setq group 
  647.                     (buffer-substring (match-beginning 1) (match-end 1)))
  648.               ;;Continuation header or new group
  649.               (if (string-equal grp-cur group)
  650.                   (replace-match "" nil nil)
  651.                 (replace-match (format "\n\n%-10sGROUP=" group) nil nil))
  652.               (forward-line -1)
  653.                 (setq grp-cur group)
  654.                 (narrow-to-region (point-min) (point)))
  655.             (widen)
  656.             (goto-char (point-max))
  657.             (insert "\n\n"))
  658.         ;;System level listing, hack out everything apart from account names
  659.         (if (match-beginning 1)
  660.             (let (account acct-cur)
  661.               (while
  662.                   (re-search-backward 
  663.                      "^ACCOUNT= +\\([A-Z][A-Z0-9]*\\)\\(.\\|\n\\)*"
  664.                      nil t)
  665.                 (setq account
  666.                       (buffer-substring (match-beginning 1) (match-end 1)))
  667.                 ;;Continuation header or new account
  668.                 (if (string-equal acct-cur account)
  669.                     (replace-match "" nil nil)
  670.                     (replace-match (format "%-10sACCOUNT=" account) nil nil))
  671.                 (forward-line -1)
  672.                 (setq acct-cur account)
  673.                 (narrow-to-region (point-min) (point)))
  674.               (widen)
  675.               (goto-char (point-max))
  676.               (insert "\n\n")))))))
  677.  
  678. ;;; end of efs-mpe.el
  679.